/*
    This file is part of the substandard lisp implementation of Standard Lisp
    Copyright (C) 2011 Nicky Nickell

    substandard lisp is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

/*
    builtins composites as defined in section 3.13 of the
    The Standard Lisp Report
*/

interpreted_builtins['append'] =
"(de append (u v) \
  (cond \
    ((null u) v) \
    (T (cons (car u) (append (cdr u) v)))))";

interpreted_builtins['assoc'] = 
"(de assoc (u v) \
  (cond \
    ((null v) NIL) \
    ((atom (car v)) (error 0 (list v \"is a poorly formed alist\"))) \
    ((equal u (caar v)) (car v)) \
    (T (assoc u (cdr v)))))";

interpreted_builtins['deflist'] = 
"(de deflist (u ind) \
  (cond \
    ((null u) NIL) \
    (T (cons \
        (progn \
          (put (caar u) ind (cadar u)) \
          (caar u)) \
        (deflist (cdr u) ind)))))";

interpreted_builtins['delete'] = 
"(de delete (u v) \
  (cond \
    ((null v) NIL) \
    ((equal (car v) u) (cdr v)) \
    (T (cons (car v) (delete u (cdr v))))))";

function std_digit(a, env) {
  var u = a[0];

  return /\d/.test(print(u)) ? T : NIL;
}
builtins['digit'] = new builtin_function(std_digit, 1, false, [CLASS_ANY], FTYPE_EXPR);

function std_length(a, env) {
  var x = a[0];

  var length = 0;
  for (var p = x; p != NIL; p = p.cdr) {
    length++;
  }

  return new lisp_integer(BigInteger(length));
}
builtins['length'] = new builtin_function(std_length, 1, false, [CLASS_ANY], FTYPE_EXPR);

function std_liter(a, env) {
  var u = a[0];

  return /[A-z]/.test(print(u)) ? T : NIL;
}
builtins['liter'] = new builtin_function(std_liter, 1, false, [CLASS_ANY], FTYPE_EXPR);

interpreted_builtins['member'] = 
"(de member (a b) \
  (cond \
    ((null b) NIL) \
    ((equal a (car b)) b) \
    (T (member a (cdr b)))))";

interpreted_builtins['memq'] = 
"(de memq (a b) \
  (cond \
    ((null b) NIL) \
    ((eq a (car b)) b) \
    (T (memq a (cdr b)))))";

interpreted_builtins['nconc'] = 
"(de nconc (u v) \
  (prog (w) \
    (cond ((null u) (return v))) \
    (setq w u) \
    (prog NIL \
top   (cond ((null (cdr w)) (return NIL))) \
      (setq w (cdr w)) \
      (go top)) \
    (rplacd w v) \
    (return u)))";

interpreted_builtins['pair'] = 
"(de pair (u v) \
  (cond \
    ((and u v) (cons (cons (car u) (car v)) (pair (cdr u) (cdr v)))) \
    ((or u v) (error 0 \"different length lists in pair\")) \
    (T NIL)))";

function std_reverse(a, env) {
  var u = a[0];

  var elements = [];
  for (var p = u; p != NIL; p = p.cdr) {
    elements.push(p.car);
  }

  var head = new lisp_pair(elements[elements.length - 1], NIL);
  var ptr = head;

  for (var i = elements.length - 2; i >= 0; i--) {
    ptr.cdr = new lisp_pair(elements[i], NIL);
    ptr = ptr.cdr;
  }

  return head;
}
builtins['reverse'] = new builtin_function(std_reverse, 1, false, [TYPE_PAIR], FTYPE_EXPR);

interpreted_builtins['sassoc'] = 
"(de sassoc (u v fn) \
  (cond \
    ((null v) (fn)) \
    ((equal u (caar v)) (car v)) \
    (T (sassoc u (cdr v) fn))))";

interpreted_builtins['sublis'] = 
"(de sublis (x y) \
  (cond \
    ((null x) y) \
    (T (prog (u) \
        (setq u (assoc y x)) \
        (return \
          (cond \
            ((not (null u)) (cdr u)) \
            ((atom y) y) \
            (T (cons (sublis x (car y)) (sublis x (cdr y))))))))))";

interpreted_builtins['subst'] = 
"(de subst (u v w) \
  (cond \
    ((null w) NIL) \
    ((equal v w) u) \
    ((atom w) w) \
    (T (cons (subst u v (car w)) (subst u v (cdr w))))))";
